(define-module (kolyad packages linux)
  #:use-module (kolyad packages)
  #:use-module (gnu packages)
  #:use-module (gnu packages algebra)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages commencement)
  #:use-module (gnu packages cpio)
  #:use-module (gnu packages elf)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages rsync)
  #:use-module (gnu packages tls)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module (guix build-system linux-module)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:use-module (guix monads)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:export (make-linux-headers*
            make-linux*))


;;;
;;; Kernel sources.
;;;

(define (linux-nonfree-urls version)
  "Return a list of URLs for linux-nonfree VERSION."
  (list (string-append "mirror://kernel.org"
                        "/linux/kernel/v" (version-major version) ".x/"
                        "linux-" version ".tar.xz")))


(define (%linux-upstream-source version hash)
  (origin
    (method url-fetch)
    (uri (linux-nonfree-urls version))
    (sha256 hash)))

(define source-with-patches (@@ (gnu packages linux) source-with-patches))

(define-public linux-nonfree-5.17-version "5.17.2")
(define-public linux-nonfree-5.17-pristine-source
  (let ((version linux-nonfree-5.17-version)
        (hash (base32 "168b7zzw72k6hxbw0q402vvfir79qki9bjvxxvfi7s6g6y20z8id")))
    (%linux-upstream-source version hash)))
(define-public linux-nonfree-5.17-source
  (source-with-patches linux-nonfree-5.17-pristine-source
           '()))

(define-public linux-nonfree-5.16-version "5.16.9")
(define-public linux-nonfree-5.16-pristine-source
  (let ((version linux-nonfree-5.16-version)
        (hash (base32 "0kvlidg7qgj49in9h92sw0dnnzyrvqax2fcpq63w36f2iqiffq0n")))
    (%linux-upstream-source version hash)))
(define-public linux-nonfree-5.16-source
  (source-with-patches linux-nonfree-5.16-pristine-source
           '()))

(define-public linux-nonfree-5.15-version "5.15.11")
(define-public linux-nonfree-5.15-pristine-source
  (let ((version linux-nonfree-5.15-version)
        (hash (base32 "1km1fglpg1a67vsfx6gqz9ikb6pywdl146bhws915n8jgrz8n5y1")))
    (%linux-upstream-source version hash)))
(define-public linux-nonfree-5.15-source
  (source-with-patches linux-nonfree-5.15-pristine-source
           '()))

(define-public linux-nonfree-5.10-version "5.10.14")
(define-public linux-nonfree-5.10-pristine-source
  (let ((version linux-nonfree-5.10-version)
        (hash (base32 "0ahxga1jdgn8kxln0pn8j42qxx0dhrhm9vcpwilyjnwb36gvf9zs")))
    (%linux-upstream-source version hash)))
(define-public linux-nonfree-5.10-source
  (source-with-patches linux-nonfree-5.10-pristine-source
           '()))

(define-public linux-nonfree-5.4-version "5.4.93")
(define-public linux-nonfree-5.4-pristine-source
  (let ((version linux-nonfree-5.4-version)
        (hash (base32 "08nmwd13z10866pc16fqbj41krnvk6hxkl4nmhdkpk346r04jx6k")))
    (%linux-upstream-source version hash)))
(define-public linux-nonfree-5.4-source
  (source-with-patches linux-nonfree-5.4-pristine-source
           '()))

;;;
;;; Kernel headers.
;;;

(define* (make-linux-headers* version source name
                              #:key
                              (home-page "https://www.kernel.org/")
                              (synopsis "Linux kernel headers")
                              (description "Headers for the Linux kernel")
                              (license license:gpl2))
  (package
    (name name)
    (version version)
    (source source)
    (build-system gnu-build-system)
    (native-inputs `(("perl" ,perl)
                     ,@(if (version>=? version "4.16")
                           `(("flex" ,flex)
                             ("bison" ,bison))
                           '())
                     ,@(if (version>=? version "5.3")
                           `(("rsync" ,rsync))
                           '())))
    (arguments
     `(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (srfi srfi-1))
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (replace 'build
           (lambda _
             (let ((arch ,(system->linux-architecture
                          (or (%current-target-system)
                              (%current-system))))
                   (defconfig ,(system->defconfig
                                (or (%current-target-system)
                                    (%current-system)))))
               (setenv "ARCH" arch)
               (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
               (invoke "make" defconfig)
               (invoke "make" "mrproper" "headers_check"))))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (invoke "make"
                       (string-append "INSTALL_HDR_PATH=" out)
                       "headers_install")

               (mkdir (string-append out "/include/config"))
               (call-with-output-file
                   (string-append out
                                  "/include/config/kernel.release")
                 (lambda (p)
                   (format p "~a-default~%" ,version)))

               ;; Remove the '.install' and '..install.cmd' files; the
               ;; latter contains store paths, which pulls in bootstrap
               ;; binaries in the build environment, and prevents bit
               ;; reproducibility for the bootstrap binaries.
               (for-each delete-file (find-files out "\\.install"))

               #t))))
       #:allowed-references ()
       #:tests? #f))
    (home-page home-page)
    (synopsis synopsis)
    (description description)
    (license license)))

(define* (make-linux-nonfree-headers* version source
                                      #:key
                                      (name "linux-nonfree-headers"))
  (make-linux-headers* version source name
                       #:synopsis "Headers for mainline Linux kernel"
                       #:description "Headers for the mainline BLOB-encumbered Linux kernel."))


;;;
;;; Kernel configurations.
;;;

;; XXX: Is there a better way to implement this?
(define* (kernel-config name version arch #:key (extra-version #f))
  "Return the absolute file name of the Linux build configuration file
in form '<name>-<version>-[<extra-version>-]<arch>.conf'."
  (let* ((name (string-append name "-"
                              (version-major+minor version) "-"
                              (if extra-version (string-append extra-version "-") "")
                              (if (string=? "i386" arch) "i686" arch)
                              ".conf"))
         (file (string-append "linux/" name)))
    (search-path (%channel-aux-path) file)))

(define config->string (@@ (gnu packages linux) config->string))


;;;
;;; Kernel package utilities.
;;;

(define* (make-linux* version source supported-systems name
                      #:key
                      ;; A function that takes an arch and a variant.
                      ;; See kernel-config for an example.
                      (extra-version #f)
                      (configuration-file #f)
                      (defconfig "defconfig")
                      (extra-options (@@ (gnu packages linux) %default-extra-linux-options))
                      (home-page "https://www.kernel.org/")
                      (synopsis "Linux kernel")
                      (description "Linux is a general-purpose monolithic unix operating system kernel.")
                      (license license:gpl2))
  (package
    (name name)
    (version version)
    (source source)
    (supported-systems supported-systems)
    (build-system gnu-build-system)
    (native-inputs
     `(("perl" ,perl)
       ("bc" ,bc)
       ("openssl" ,openssl)
       ("elfutils" ,elfutils)  ; Needed to enable CONFIG_STACK_VALIDATION
       ("flex" ,flex)
       ("bison" ,bison)

       ("cpio" ,cpio)
       ("kmod" ,kmod)

       ;; These are needed to compile the GCC plugins.
       ("gmp" ,gmp)
       ("mpfr" ,mpfr)
       ("mpc" ,mpc)

       ,@(match (and configuration-file
                     (configuration-file
                       name
                       version
                       (system->linux-architecture
                         (or (%current-target-system) (%current-system)))
                       #:extra-version extra-version))
           (#f                                    ;no config available
            '())
           ((? string? config)
            `(("kconfig" ,config))))))
    (arguments 
     `(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (srfi srfi-1)
                  (srfi srfi-26)
                  (ice-9 ftw)
                  (ice-9 match))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-/bin/pwd
           (lambda _
             (substitute* (find-files "." "^Makefile(\\.include)?$")
               (("/bin/pwd") "pwd"))
             #t))
         (replace 'configure
           (lambda* (#:key inputs native-inputs target #:allow-other-keys)
             ;; Avoid introducing timestamps
             (setenv "KCONFIG_NOTIMESTAMP" "1")
             (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))

             ;; Set ARCH and CROSS_COMPILE
             (let ((arch ,(system->linux-architecture
                           (or (%current-target-system)
                               (%current-system)))))
               (setenv "ARCH" arch)
               (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))

               (when target
                 (setenv "CROSS_COMPILE" (string-append target "-"))
                 (format #t "`CROSS_COMPILE' set to `~a'~%"
                         (getenv "CROSS_COMPILE"))))

             (setenv "EXTRA_VERSION" ,extra-version)

             (let ((build  (assoc-ref %standard-phases 'build))
                   (config (assoc-ref (or native-inputs inputs) "kconfig")))

               ;; Use a custom kernel configuration file or a default
               ;; configuration file.
               (if config
                   (begin
                     (copy-file config ".config")
                     (chmod ".config" #o666))
                   (invoke "make" ,defconfig))

               ;; Appending works even when the option wasn't in the
               ;; file.  The last one prevails if duplicated.
               (let ((port (open-file ".config" "a"))
                     (extra-configuration ,(config->string extra-options)))
                 (display extra-configuration port)
                 (close-port port))

               (invoke "make" "oldconfig"))))
         (replace 'install
           (lambda* (#:key inputs native-inputs outputs #:allow-other-keys)
             (let* ((out    (assoc-ref outputs "out"))
                    (moddir (string-append out "/lib/modules"))
                    (dtbdir (string-append out "/lib/dtbs")))
               ;; Install kernel image, kernel configuration and link map.
               (for-each (lambda (file) (install-file file out))
                         (find-files "." "^(\\.config|bzImage|zImage|Image|vmlinuz|System\\.map|Module\\.symvers)$"))
               ;; Install device tree files
               (unless (null? (find-files "." "\\.dtb$"))
                 (mkdir-p dtbdir)
                 (invoke "make" (string-append "INSTALL_DTBS_PATH=" dtbdir)
                         "dtbs_install"))
               ;; Install kernel modules
               (mkdir-p moddir)
               (invoke "make"
                       ;; Disable depmod because the Guix system's module directory
                       ;; is an union of potentially multiple packages.  It is not
                       ;; possible to use depmod to usefully calculate a dependency
                       ;; graph while building only one of those packages.
                       "DEPMOD=true"
                       (string-append "MODULE_DIR=" moddir)
                       (string-append "INSTALL_PATH=" out)
                       (string-append "INSTALL_MOD_PATH=" out)
                       "INSTALL_MOD_STRIP=--strip-debug --enable-deterministic-archives"
                       "modules_install")
               (let* ((versions (filter (lambda (name)
                                          (not (string-prefix? "." name)))
                                        (scandir moddir)))
                      (version (match versions
                                ((x) x))))
                 ;; There are symlinks to the build and source directory,
                 ;; both of which will point to target /tmp/guix-build*
                 ;; and thus not be useful in a profile.  Delete the symlinks.
                 (false-if-file-not-found
                  (delete-file (string-append moddir "/" version "/build")))
                 (false-if-file-not-found
                  (delete-file (string-append moddir "/" version "/source"))))
               #t)))
         (add-after 'install 'remove-signing-data
            (lambda _
              (let ((build-files '("certs/signing_key.pem" "certs/signing_key.x509" "certs/x509.genkey")))
                (for-each (lambda (file)
                            (when (file-exists? file) (delete-file file)))
                          build-files))
              #t))
         (delete 'strip))   ; Stripping is already done when installing modules.
       #:tests? #f))
    (home-page home-page)
    (synopsis synopsis)
    (description description)
    (license license)))

(define* (make-linux-nonfree* version source supported-systems
                              #:key
                              (variant #f)
                              (extra-version #f)
                              (configuration-file #f)
                              (defconfig "defconfig")
                              (extra-options (@@ (gnu packages linux) %default-extra-linux-options)))
  (make-linux* version source supported-systems
               ;;name
               (string-append "linux-nonfree"
                              (if variant (string-append "-" variant) "")
                              (if extra-version (string-append "-" variant) "")) ; add extra-version information to package-name
               #:extra-version extra-version ; add to kernel env and fetch correct config file
               #:configuration-file configuration-file
               #:defconfig defconfig
               #:extra-options extra-options
               #:synopsis "Mainline Linux Kernel"
               #:description "The BLOB-encumbered mainline Linux kernel"))


;;;
;;; Kernel packages.
;;;
(define-public linux-nonfree-5.17
  (make-linux-nonfree* linux-nonfree-5.17-version
                       linux-nonfree-5.17-source
                       '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")))

(define-public linux-nonfree-5.16
  (make-linux-nonfree* linux-nonfree-5.16-version
                       linux-nonfree-5.16-source
                       '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")))

(define-public linux-nonfree-5.15
  (make-linux-nonfree* linux-nonfree-5.15-version
                       linux-nonfree-5.15-source
                       '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")))

(define-public linux-nonfree-5.10
  (make-linux-nonfree* linux-nonfree-5.10-version
                       linux-nonfree-5.10-source
                       '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")))

(define-public linux-nonfree-5.4
  (make-linux-nonfree* linux-nonfree-5.4-version
                       linux-nonfree-5.4-source
                       '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")))

;; Modules (may be) signed with random keys, thus the kernels (may not be) reproducible.
(define-public linux-nonfree-workstation-thinkpad-x1c5-5.17
  (make-linux-nonfree* linux-nonfree-5.17-version
                       linux-nonfree-5.17-source
                       '("x86_64-linux")
                       #:variant "workstation-thinkpad-x1c5"
                       #:configuration-file kernel-config))

(define-public linux-nonfree-workstation-thinkpad-x1c5-5.16
  (make-linux-nonfree* linux-nonfree-5.16-version
                       linux-nonfree-5.16-source
                       '("x86_64-linux")
                       #:variant "workstation-thinkpad-x1c5"
                       #:configuration-file kernel-config))

(define-public linux-nonfree-workstation-thinkpad-x1c5-5.15
  (make-linux-nonfree* linux-nonfree-5.15-version
                       linux-nonfree-5.15-source
                       '("x86_64-linux")
                       #:variant "workstation-thinkpad-x1c5"
                       #:configuration-file kernel-config))

(define-public linux-nonfree-workstation-thinkpad-x1c5-5.10
  (make-linux-nonfree* linux-nonfree-5.10-version
                       linux-nonfree-5.10-source
                       '("x86_64-linux")
                       #:variant "workstation-thinkpad-x1c5"
                       #:configuration-file kernel-config))

(define-public linux-nonfree-workstation-thinkpad-x1c5  linux-nonfree-workstation-thinkpad-x1c5-5.17)

(define-public linux-nonfree-version         linux-nonfree-5.17-version)
(define-public linux-nonfree-pristine-source linux-nonfree-5.17-pristine-source)
(define-public linux-nonfree-source          linux-nonfree-5.17-source)
(define-public linux-nonfree                 linux-nonfree-5.17)

(define-public linux-debug
  (package
    (name "linux-debug")
    (version "0")
    (source #f)
    (propagated-inputs
      (modify-inputs (append %final-inputs (package-native-inputs linux-nonfree))
        (prepend
          ncurses
          gtk+-2
          `(,glib "bin")
          libglade
          pkg-config)))
    (build-system trivial-build-system)
    (arguments '(#:builder (mkdir %output)))
    (synopsis "dependency stub for maintenence of the linux-nonfree packages")
    (description "dependency stub for maintenence of the linux-nonfree packages")
    (home-page #f)
    (license license:gpl3+)))

;;; vim: set expandtab tabstop=2 shiftwidth=2
;;; end of file linux.scm
